module Choice where

import Accessor(Accessor, getter, setter)


data Choice s c a = Choice { runChoice :: s -> [Maybe c] -> [(a, s, [Maybe c])] }
                  

instance Monad (Choice s c) where
    return x = Choice $ \s cs -> [(x, s, cs)]

    Choice f >>= g = Choice aux
        where
          aux s cs = do (a, s', cs') <- f s cs
                        (runChoice $ g a) s' cs'


failure :: Choice s c a
-----------------------
failure = Choice $ \c cs -> []


getCurrentState :: Choice s c s
-------------------------------
getCurrentState = Choice $ \s cs -> [(s, s, cs)]


setCurrentState :: s -> Choice s c ()
-------------------------------------
setCurrentState s' = Choice $ \s cs -> [((), s', cs)]


choice :: Eq c => [c] -> Choice s c c
-------------------------------------
choice choices = Choice aux
    where
      aux s (Nothing : cs) = [ (c, s, cs) | c <- choices ]
      aux s (Just c : cs)
          | c `elem` choices  = [ (c, s, cs) ]
          | otherwise         = error "invalid choice"


get :: Accessor s a -> Choice s c a
-----------------------------------
get acc = do s <- getCurrentState
             return $ getter acc s


set :: Accessor s a -> a -> Choice s c ()
-----------------------------------------
set acc x = do s <- getCurrentState
               setCurrentState $ setter acc s x


with :: Accessor s a -> (a -> b) -> Choice s c b
------------------------------------------------
with acc f = do a <- get acc
                return $ f a


update :: Accessor s a -> (a -> a) -> Choice s c ()
---------------------------------------------------
update acc f = do a <- get acc
                  let a' = f a
                  set acc a'
